perm filename EUCLID.FAI[GEM,MUS]1 blob
sn#144450 filedate 1976-07-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
C00006 00003 SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) OBJECT TRANSLATION WRT FRAME.
C00008 00004 SUBR(ROTATE,FRMOBJ,CX,CY,CZ) OBJECT ROTATION WRT FRAME.
C00011 00005
C00013 00006 SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) DILATION-REFLECTION WRT FRAME.
C00014 00007 SUBR(APTRAN,OBJECT,TRAN) APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
C00018 00008 SUBN(ROTOR)
C00020 00009 SUBR(INTRAN,TRAN) INVERT A TRANSFORMATION.
C00022 00010 SUBR(MKROT1,PAN,TILT,SWING)
C00025 00011 SUBR(MKQFRM,DX,DY,DZ) MAKE FRAME WITH RESPECT TO VECTOR.
C00027 00012 SUBR(NORM,FRAME) NORMALIZE A FRAME MATRIX.
C00038 00013 SUBR(ORTHO2,QFRAME) ORTHOGONALIZE A MATRIX.
C00041 00014 SUBR(ANGL3V,VERT1,VERT2,VERT3) ANGLE TRI-VERTEX.
C00044 00015 SUBR(DISTAN,V1,V2) DISTANCE BETWEEN TWO VERTICES.
C00045 00016 ENORM & VNORM
C00047 00017 SUBR(QEV,EDGE,VERTEX) DISTANCE VERTEX TO EDGE.
C00049 00018 SUBR(ZDEPTH,FACE,VERTEX) ZPP DEPTH.
C00051 00019 DEFINE TJOINT(Q,V)<CAR Q,2(V)>
C00053 00020 SUBR(PPROJ,CAMERA,WORLD)
C00056 00021 SUBR(VPROJ,VERTEX,CAMERA) VERTEX PERSPECTIVE PROJECTION.
C00059 00022 SUBR(UNPROJECT,VERTEX,CAMERA)
C00061 00023 SUBR(FACOEF,BF) FACE COEFFICIENTS. BF>0 WC, BF<0 PP.
C00064 00024 SUBR(WITH3D,FACE,X,Y,Z) TEST FOR LOCUS WITHIN FACE 3D.
C00067 00025 SUBR(SOLANG,VERTEX) DIHEDRAL ANGLE AT A PIERCING VERTEX.
C00069 00026 END
C00070 ENDMK
C⊗;
TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
.INSERT MN
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKCOPY,MKFRAME,KLNODE
EXTERN SIN,COS,SQRT,ATAN,ATAN2,ASIN,ACOS,LOG,HALFPI,PI,TWOPI
COMMENT ⊗----------------------------------------------------------------------
EUCLIDEAN TRANSFORMATIONS
TRANS ← TRANSL(XWD(FRAME,BODY),DX,DY,DZ);
TRANS ← ROTATE(XWD(FRAME,BODY),WX,WY,WZ);
TRANS ← SHRINK(XWD(FRAME,BODY),KX,KY,KZ);
TRANS ← APTRAN(ENTITY,TRANS);
{ROTOR}
TRANS ← INTRAN(TRAN);
FRAME MAKERS
TRANS ← MKROT1(PAN,TILT,SWING); MAKE FROM EULER ANGLES.
TRANS ← MKFFRM(FACE); MAKE FACE FRAME.
TRANS ← MKQFRM(WX,WY,WZ); MAKE FROM ROTATION VECTOR.
ORTHONORMALIZATION.
NORM(FRAME) ;NORMALIZATION TO UNIT VECTORS.
ORTHO1(FRAME) ;ORTHOGONALIZE BY WORST CASE.
ORTHO2(FRAME) ;ORTHOGONALIZE BY K ← (I CROSS J), J ← (K CROSS I).
GEOMETRIC MEASURE ROUTINES.
DETERM(FRAME)
ANGL3V(V1,V2,V3)
DISTANCE(ENTITY,ENTITY);
VECTOR ROUTINES.
TENSOR ROUTINES.
SPATIAL PREDICATES.
IMAGE PROJECTION.
------------------------------------------------------------------------------⊗
SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) ;OBJECT TRANSLATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
HRLZI DX↔HRRI XWC(1)↔BLT ZWC(1) ;DELTA'S OF TRANSLATION.
↑QTRAN: DAC 1,TMP1 ;SECOND ENTRY.
MOVM 2,FRMOBJ↔CDR 2,2↔DAC 2,OBJECT
HLRE 1,FRMOBJ↔SKIPGE 1↔GO[
SETZ 1,↔JUMPE 2,.+1 ;JUMP WHEN NO OBJECT.
CALL(BGET,OBJECT) ;GET BODY OF THE OBJECT.
FRAME 1,1↔GO .+1] ;GET FRAME OF THE BODY.
DAC 1,REFRAM ;FRAME OF REFERENCE.
LAC 1,TMP1↔SKIPN REFRAM↔GO L1
L0: SETQ(TMP2,{MKCOPY,REFRAM})
CALL(INTRAN,TMP2)
CALL(APTRAN,TMP2,TMP1)
CALL(APTRAN,TMP2,REFRAM)
CALL(KLNODE,TMP1)
LAC 1,TMP2↔DAC 1,TMP1 ;TMP1 ← TMP2.
L1: SKIPN OBJECT↔POP4J ;RETURN TRANSFORMATION.
CALL(APTRAN,OBJECT,TMP1)
CALL(KLNODE,TMP1)
LAC 1,OBJECT↔POP4J ;RETURN THE OBJECT.
DECLARE{TMP1,TMP2,REFRAM,OBJECT}
ENDR TRANSLATE;3/18/73(BGB)------------------------------------------
SUBR(ROTATE,FRMOBJ,CX,CY,CZ) ;OBJECT ROTATION WRT FRAME.
COMMENT .---------------------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,CX↔FMPR 1,1↔LAC 1
SKIPE 1,CY↔FMPR 1,1↔FADR 1
SKIPE 1,CZ↔FMPR 1,1↔FADR 1
JUMPE POP4J.
SETQ(W,{SQRT↑,0}) ;RADIANS OF ROTATION.
SETQ(C,{COS,W})
SETQ(S,{SIN,W})
MOVSI (<1.0>)↔FDVR W
FMPRM CX↔FMPRM CY↔FMPRM CZ ;NORMALIZE INTO THE STACK.
;COMPUTE ROTATION MATRIX.
;1/ (1-CW)*CX↑2 + CW 2/ (1-CW)*CX*CY + CZ*SW 3/ (1-CW)*CX*CZ - CY*SW
;4/ (1-CW)*CX*CY - CZ*SW 5/ (1-CW)*CY↑2 + CW 6/ (1-CW)*CY*CZ + CX*SW
;7/ (1-CW)*CX*CZ + CY*SW 8/ (1-CW)*CY*CZ - CX*SW 9/ (1-CW)*CZ↑2 + CW
MOVSI 1,(<1.0>)↔FSBR 1,C ; (1-C) IN ALL POSITIONS.
LAC[XWD 1,2]↔BLT 9
FMPR 1,CX↔FMPR 1,CX↔FADR 1,C ;DIAGONAL ELEMENTS.
FMPR 5,CY↔FMPR 5,CY↔FADR 5,C
FMPR 9,CZ↔FMPR 9,CZ↔FADR 9,C
LAC CX↔FMPR CY↔FMPR 2,↔FMPR 4, ;(1-CW) PRODUCTS.
LAC CX↔FMPR CZ↔FMPR 3,↔FMPR 7,
LAC CY↔FMPR CZ↔FMPR 6,↔FMPR 8,
LAC CX↔FMPR S↔FADR 6,↔FSBR 8, ;CX*S PRODUCTS.
LAC CY↔FMPR S↔FADR 7,↔FSBR 3, ;CY*S
LAC CZ↔FMPR S↔FADR 2,↔FSBR 4, ;CZ*S
CALL(MKNODE↑,1)↔DAC 1,TMP1
MOVSI 2↔HRRI IY(1)↔BLT KZ(1)
GO QTRAN
DECLARE{W,C,S,TMP1}
ENDR ROTATE; BGB & HANS P. MORAVEC & MACSYMA 3 JUNE 1974 ----------------------
COMMENT ⊗
SUBR(ROTATE,FRMOBJ,WX,WY,WZ) ;OBJECT ROTATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,WX↔FMPR 1,1↔DAC 1,4
SKIPE 2,WY↔FMPR 2,2↔DAC 2,5
SKIPE 3,WZ↔FMPR 3,3
FADR 1,2↔FADR 1,3↔JUMPE 1,POP1J.
SETQ(W,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7
LAC 1,WX↔FDVR 1,W↔DAC 1,IX(7)
LAC 2,WY↔FDVR 2,W↔DAC 2,IY(7)
LAC 3,WZ↔FDVR 3,W↔DAC 3,IZ(7)
MOVM 2↔CAMG [0.99]↔GO .+3 ;W ALMOST COLINEAR WITH J VECTOR.
SETZM JY(7)↔DAC 2,JX(7) ;CHANGE J VECTOR.
CALL(ORTHO2,TMP1)↔CALL(NORM,TMP1)
;ROTATION ABOUT I UNIT VECTOR.
SETQ(TMP2,{MKFRAME})
CALL(COS,W)↔LAC 2,TMP2↔DAC 1,JY(2)↔DAC 1,KZ(2)
CALL(SIN,W)↔LAC 2,TMP2↔DAC 1,JZ(2)↔MOVNM 1,KY(2)
CALL(APTRAN,TMP2,TMP1)
LAC 1,TMP1 ;TRANSPOSITION.
LAC IY(1)↔EXCH JX(1)↔DAC IY(1)
LAC IZ(1)↔EXCH KX(1)↔DAC IZ(1)
LAC JZ(1)↔EXCH KY(1)↔DAC JZ(1)
CALL(APTRAN,TMP1,TMP2)↔CALL(KLNODE,TMP2)
LAC 1,TMP1↔GO QTRAN
DECLARE{W,TMP1,TMP2,TMP3,REFRAM,OBJECT}
ENDR ROTATE;3/18/73(BGB)---------------------------------------------
⊗
SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) ;DILATION-REFLECTION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
SKIPN 2,KKX↔MOVSI 2,(1.0)↔DAC 2,IX(1)
SKIPN 2,KKY↔MOVSI 2,(1.0)↔DAC 2,JY(1)
SKIPN 2,KKZ↔MOVSI 2,(1.0)↔DAC 2,KZ(1)↔GO QTRAN
ENDR SHRINK;3/18/73(BGB)---------------------------------------------
SUBR(APTRAN,OBJECT,TRAN); APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,X,Y,Z,TRN,N,OBJ,E0}
SKIPE OBJ,OBJECT↔SKIPN TRN,TRAN↔POP2J ;IGNORE ZERO ARGS.
MOVM 1,(OBJ)↔JUMPE 1,LROTA ;GET TYPE OF OBJECT.
TLNE 1,(1B9)↔GO LROTA ;FRAME.
ANDI 1,17↔GO @.+1(1) ;DISPATCH ON TYPE OF OBJECT.
POP2J.↔POP2J.↔POP2J.↔CROTA ;FRAME EMPTY UNIVERSE SUN
CROTA↔POP2J.↔POP2J.↔POP2J. ;CAMERA WORLD WINDOW IMAGE
POP2J.↔POP2J.↔POP2J.↔POP2J. ;TEXT XNODE YNODE ZNODE
BROTA↔FROTA↔EROTA↔VROTA ;BODY FACE EDGE VERTEX
;....................................................................
LROTA: LAC V,OBJ↔SETZM TMP2#↔GO .+3 ;FRAME CASE.
CROTA: FRAME V,OBJ↔DAC V,TMP2# ;CAMERA & SUN CASE.
CALL(ROTOR)
PUSH P,XWC(TRN)↔PUSH P,YWC(TRN)↔PUSH P,ZWC(TRN)
SETZM XWC(TRN)↔SETZM YWC(TRN)↔SETZM ZWC(TRN)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
POP P,ZWC(TRN)↔POP P,YWC(TRN)↔POP P,XWC(TRN)
SKIPN TMP2↔POP2J
CALL(NORM,TMP2#)
CALL(ORTHO1,TMP2#)↔POP2J
;....................................................................
BROTA: LAC B,OBJ ;BODY ROTATION.
TESTZ B,BDVBIT↔GO L2 ;DON'T MOVE VERTICES.
LAC V,B ;1ST VERTEX.
L1: PVT V,V
CAMN V,OBJ↔GO L2 ;SKIP WHEN VERTEX.
CALL(ROTOR)↔GO L1 ;ROTATE VERTEX.
L2: LAC B,OBJ
TESTZ B,BDLBIT↔GO L3 ;DON'T MOVE FRAME.
FRAME V,B↔SKIPN V↔GO L3
DAC V,TMP#↔PUSH P,B
CALL(APTRAN,V,TRN) ;BODY'S FRAME.
CALL(NORM,TMP#)
CALL(ORTHO1,TMP#)↔POP P,B
;PARTS OF THIS BODY.
L3: TESTZ B,BDPBIT↔POP2J ;DON'T MOVE PARTS.
SON N,B↔JUMPE N,POP2J.
L4: CALL(APTRAN,N,N,TRN)
POP P,N↔LAC B,OBJECT
BRO N,N↔SON 0,B
CAME 0,N↔GO L4↔POP2J
;....................................................................
FROTA: LAC F,OBJ↔NCNT N,F↔MOVMS N ;FACE ROTATION.
PED E,F↔DAC E,E0↔JUMPE E0,[ ;VERTEX FACE.
PFACE B,F↔PVT V,B↔CALL(ROTOR)↔POP2J]
PCW 0,E↔SKIPN N↔CAMN 0,E↔GO[ ;WIRE OR SHELL FACE.
SETQ(V,{VCW,E,F})↔CALL(ROTOR)↔GO .+1]
L5: SETQ(V,{VCCW,E,F})
CALL(ROTOR)↔CALL(ECCW,E,F)
CAMN 1,E↔POP2J ;END OF WIRE FACE.
LAC E,1↔CAMN E,E0↔POP2J ;END OF NORMAL FACE.
SOJN N,L5↔POP2J ;END OF SHELL FACE.
;....................................................................
EROTA: LAC E,OBJ ;EDGE ROTATION
PVT V,E↔CALL(ROTOR)
NVT V,E↔CALL(ROTOR)↔POP2J
VROTA: LAC V,OBJ↔CALL(ROTOR)↔POP2J ;VERTEX ROTATION.
ENDR APTRAN;1/14/73(BGB)------------------------------------------
SUBN(ROTOR)
COMMENT ⊗------------------------------------------------------------
; APTRAN's inner most subroutine.
; Expects arguments in V and Q. Clobbers 1,2,X,Y,Z.
;
; X ← XWC(V);
; Y ← YWC(V);
; Z ← ZWC(V);
;
; XWC(V) ← X*IX(Q) + Y*JX(Q) + Z*KX(Q) + XWC(Q);
; YWC(V) ← X*IY(Q) + Y*JY(Q) + Z*KZ(Q) + YWC(Q);
; ZWC(V) ← X*IZ(Q) + Y*JZ(Q) + Z*KZ(Q) + ZWC(Q);
⊗
ACCUMULATORS{B,F,E,V,X,Y,Z,Q}
LAC X,XWC(V)↔LAC Y,YWC(V)↔LAC Z,ZWC(V)
LAC 1,IX(Q)↔CAMN 1,[1.0]↔SKIPA 1,X↔FMPR 1,X
SKIPE 2,JX(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,KX(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,XWC(Q)↔FADR 1,2↔DAC 1,XWC(V)
LAC 1,JY(Q)↔CAMN 1,[1.0]↔SKIPA 1,Y↔FMPR 1,Y
SKIPE 2,IY(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,KY(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,YWC(Q)↔FADR 1,2↔DAC 1,YWC(V)
LAC 1,KZ(Q)↔CAMN 1,[1.0]↔SKIPA 1,Z↔FMPR 1,Z
SKIPE 2,JZ(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,IZ(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,ZWC(Q)↔FADR 1,2↔DAC 1,ZWC(V)
POP0J
ENDR ROTOR;3/18/73(BGB)-------------------------------------------
SUBR(INTRAN,TRAN) ;INVERT A TRANSFORMATION.
COMMENT .-----------------------------------------------------------.
Q ←← 6
LAC 2,TRAN
MOVSI XWC(2)↔HRRI XWC+Q↔BLT KZ+Q
;XWC' ← -(XWC*IX + YWC*IY + ZWC*IZ);
LAC 1,XWC+Q↔FMPR 1,IX+Q
LAC YWC+Q↔FMPR IY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR IZ+Q↔FADR 1,0
MOVNM 1,XWC(2)
;YWC' ← -(XWC*JX + YWC*JY + ZWC*JZ);
LAC 1,XWC+Q↔FMPR 1,JX+Q
LAC YWC+Q↔FMPR JY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR JZ+Q↔FADR 1,0
MOVNM 1,YWC(2)
;ZWC' ← -(XWC*KX + YWC*KY + ZWC*KZ);
LAC 1,XWC+Q↔FMPR 1,KX+Q
LAC YWC+Q↔FMPR KY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR KZ+Q↔FADR 1,0
MOVNM 1,ZWC(2)
;TRANSPOSE ROTATION MATRIX.
DAC JX+Q,IY(2)
DAC KX+Q,IZ(2)
DAC IY+Q,JX(2)
DAC KY+Q,JZ(2)
DAC IZ+Q,KX(2)
DAC JZ+Q,KY(2)
LAC 1,2
POP1J
ENDR INTRAN;3/18/73(BGB)---------------------------------------------
SUBR(MKROT1,PAN,TILT,SWING)
COMMENT .-----------------------------------------------------------.
SETQ(CP,{COS,PAN})↔ SETQ(SP,{SIN,PAN})
SETQ(CT,{COS,TILT})↔ SETQ(ST,{SIN,TILT})
SETQ(CS,{COS,SWING})↔ SETQ(SS,{SIN,SWING})
CALL(MKFRAME)
LAC SP↔FMP CT↔FMP SS↔DAC 2↔LAC CP↔FMP CS↔FSB 2↔DAC IX(1)
LAC CP↔FMP CT↔FMP SS↔DAC 2↔LAC SP↔FMP CS↔FAD 2↔DAC IY(1)
LAC ST↔FMP SS↔DAC IZ(1)
LAC SP↔FMP CT↔FMP CS↔DAC 2↔LAC CP↔FMP SS↔FAD 2↔MOVNM JX(1)
LAC CP↔FMP CT↔FMP CS↔DAC 2↔MOVN SP↔FMP SS↔FAD 2↔DAC JY(1)
LAC ST↔FMP CS↔DAC JZ(1)
LAC SP↔FMP ST↔DAC KX(1)
LAC CP↔FMP ST↔MOVNM KY(1)
LAC CT↔DAC KZ(1)↔POP3J
DECLARE{CP,CT,CS,SP,ST,SS}
ENDR MKROT1;10/30/73(BGB)--------------------------------------------
SUBR(MKFFRM,FACE) ;MAKE FACE FRAME.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0,V,X,Y,Z,N}
LAC F,FACE↔PED E,F↔DAC E,E0
SETZB X,Y↔SETZB Z,N
L1: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
CAME E,E0↔AOJA N,L1↔AOS N
;CENTER OF FACE BECOMES ORIGIN.
FLOAT N,↔FDVR X,N↔FDVR Y,N↔FDVR Z,N
SETQ(F,{MKFRAME})↔DAC F,FRM#
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
;FIRST TWO VECTORS.
SETQ(V,{VCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC IX(F)
LAC YWC(V)↔FSBR Y↔DAC IY(F)
LAC ZWC(V)↔FSBR Z↔DAC IZ(F)
SETQ(V,{VCCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC JX(F)
LAC YWC(V)↔FSBR Y↔DAC JY(F)
LAC ZWC(V)↔FSBR Z↔DAC JZ(F)
CALL(ORTHO2,FRM)
CALL(NORM,FRM)
CALL(ORTHO1,FRM)
LAC 1,FRM↔POP1J
ENDR MKFFRM;2/19/74(BGB)---------------------------------------------
SUBR(MKQFRM,DX,DY,DZ) ;MAKE FRAME WITH RESPECT TO VECTOR.
COMMENT .-----------------------------------------------------------.
;NORMALIZE THE COMPONENTS OF THE VECTOR.
SKIPE 1,DX↔FMPR 1,1↔DAC 1,4
SKIPE 2,DY↔FMPR 2,2↔DAC 2,5
SKIPE 3,DZ↔FMPR 3,3
FADR 1,2↔FADR 1,3
SETQ(R,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7↔SKIPN R↔POP3J
LAC 1,DX↔DAC 1,XWC(7)↔FDVR 1,R↔DAC 1,IX(7)↔DAC 1,JY(7)
LAC 2,DY↔DAC 2,YWC(7)↔FDVR 2,R↔DAC 2,IY(7)↔DAC 2,JX(7)
LAC 3,DZ↔DAC 3,ZWC(7)↔FDVR 3,R↔DAC 3,IZ(7)↔SETZM JZ(7)
MOVM 3↔CAMLE[0.999]↔MOVNM JY(7)
CALL(ORTHO2,TMP1)
CALL(NORM,TMP1)
LAC 1,TMP1
POP3J
DECLARE{R,TMP1}
ENDR MKQFRM;3/6/74(BGB)----------------------------------------------
SUBR(NORM,FRAME) ; NORMALIZE A FRAME MATRIX.
COMMENT .-----------------------------------------------------------.
;ACCUMULATORS:
; 05 06 07 IX IY IZ
; 10 11 12 JX JY JZ
; 13 14 15 KX KY KZ.
SAVAC(15)
MOVS FRAME↔HRRI 5↔BLT 15
; R ← SQRT(A↑2+B↑2+C↑2); A←A/R; B←B/R; C←C/R;
FOR Q IN (5,10,13){
MOVM 1,Q↔CAMG 1,[1.0E-8]↔SETZB 1,Q↔FMPR 1,1
MOVM 1+Q↔CAMG 0,[1.0E-8]↔SETZB 1+Q↔FMPR↔FADR 1,0
MOVM 2+Q↔CAMG 0,[1.0E-8]↔SETZB 2+Q↔FMPR↔FADR 1,0
SKIPE 1↔CAMN 1,[1.0]↔GO .+6↔CALL(SQRT,1)
FDVR Q,1↔FDVR Q+1,1↔FDVR Q+2,1}
;PUT'EM DOWN.
LAC 1,FRAME
MOVSI 5↔HRRI IX(1)↔BLT KZ(1)
GETAC(15)↔POP1J
ENDR NORM;1/14/73----------------------------------------------------
SUBR(ORTHO1,FRAME) ; ORTHOGONALIZE AN ORIENTATION MATRIX.
COMMENT .-----------------------------------------------------------.
;IT IS ASSUMED THAT THE ROW VECTORS ARE UNIT VECTORS.
X←←0 ↔ Y←←1 ↔ Z←←2 ;ADDRESS DISPLACEMENTS.
Q←←9 ↔ R←←13 ↔ A←←14 ↔ B←←15 ;ACCUMULATORS.
SAVAC(15)↔SETOM FLG# ;FIRST TIME THRU FLAG.
L0: LAC R,FRAME
MOVSI Q,IX(R)↔BLT Q,KZ ;FIRST NINE ACCUMULATORS.
;DOT EACH ROW VECTOR INTO THE NEXT ROW.
FMPR IX,JX↔FMPR IY,JY↔FMPR IZ,JZ
FADR IX,IY↔FADR IX,IZ
FMPR JX,KX↔FMPR JY,KY↔FMPR JZ,KZ
FADR JX,JY↔FADR JX,JZ
FMPR KX,IX(R)↔FMPR KY,IY(R)↔FMPR KZ,IZ(R)
FADR KX,KY↔FADR KX,KZ
;TAKE ABSOLUTE VALUES AND FIND THE WORST TOTAL COSINE.
MOVMS IX↔MOVMS JX↔MOVMS KX
LAC Q,KX↔FADR KX,JX↔FADR JX,IX↔FADR Q,IX
EXCH Q,JX↔SETZM SIGN#
MOVEI 1,IX(R)↔MOVEI 2,JX(R)↔MOVEI 3,KX(R) ;GET ROW POINTERS.
CAML Q,IX↔GO .+4
EXCH 2,1↔EXCH Q,IX↔SETCMM SIGN ;GET 2 BIGGER THAN 1.
CAML KX,Q↔GO .+4
EXCH 3,2↔EXCH KX,Q↔SETCMM SIGN ;GET 3 BIGGER THAN 2.
CAMG KX,[0.00001]↔GO L1 ;GOOD ENUF FOR GOVERNMENT WORK.
;STRAIGHTEN UP THE WORST VECTOR.
LAC A,Y(1)↔FMPR A,Z(2)
LAC B,Y(2)↔FMPR B,Z(1)↔FSBR A,B↔DAC A,X(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM X(3)
LAC A,X(2)↔FMPR A,Z(1)
LAC B,X(1)↔FMPR B,Z(2)↔FSBR A,B↔DAC A,Y(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Y(3)
LAC A,X(1)↔FMPR A,Y(2)
LAC B,X(2)↔FMPR B,Y(1)↔FSBR A,B↔DAC A,Z(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Z(3)
SKIPE SIGN↔GO[MOVNS X(3)↔MOVNS Y(3)↔MOVNS Z(3)↔GO .+1]
SKIPN FLG↔GO L1↔SETZM FLG↔GO L0
L1: GETAC(15)↔POP1J
ENDR ORTHO1;1/14/73(BGB)---------------------------------------------
SUBR(ORTHO2,QFRAME) ;ORTHOGONALIZE A MATRIX.
COMMENT .-----------------------------------------------------------.
;ACCEPT I; K' ← I CROSS J; J' ← K CROSS I;
LAC 1,QFRAME
SETZM KX(1)↔SETZM KY(1)↔SETZM KZ(1)
MOVS QFRAME↔HRRI 1↔BLT 9
LAC 12,4↔LAC 13,5↔LAC 14,6 ;SAVE J VECTOR.
;VECTOR-K ← VECTOR-I CROSS VECTOR-J.
LAC 2↔FMP 6↔DAC 7
LAC 5↔FMP 3↔FSB 7,
LAC 4↔FMP 3↔DAC 8
LAC 1↔FMP 6↔FSB 8,
LAC 1↔FMP 5↔DAC 9
LAC 4↔FMP 2↔FSB 9,
;VECTOR-J ← VECTOR-K CROSS VECTOR-I.
LAC 8↔FMP 3↔DAC 4
LAC 2↔FMP 9↔FSB 4,
LAC 1↔FMP 9↔DAC 5
LAC 7↔FMP 3↔FSB 5,
LAC 7↔FMP 2↔DAC 6
LAC 1↔FMP 8↔FSB 6,
LAC 15,QFRAME↔MOVSI 1
HRRI IX(15)↔BLT KZ(15)
LAC 1,QFRAME↔POP1J
ENDR ORTHO2;3/30/73(BGB)---------------------------------------------
SUBR(DETERM,FRAME)
COMMENT .-----------------------------------------------------------.
MOVS FRAME↔HRRI 1↔BLT 9
LAC 5↔FMP 9↔LAC 12,
LAC 6↔FMP 8↔FSB 12,↔FMP 1,12
LAC 6↔FMP 7↔LAC 12,
LAC 4↔FMP 9↔FSB 12,↔FMP 2,12↔FAD 1,2
LAC 4↔FMP 8↔LAC 12,
LAC 5↔FMP 7↔FSB 12,↔FMP 3,12↔FAD 1,3↔POP1J
ENDR DETERM;4/1/73(BGB)----------------------------------------------
SUBR(ANGL3V,VERT1,VERT2,VERT3) ;ANGLE TRI-VERTEX.
COMMENT .-----------------------------------------------------------.
;ANGLE V1,V2,V3 CCW; RETURNS VALUE 0 TO 2π.
V1 ←← 13
V2 ←← 14
V3 ←← 15
;DETERMINE WHETHER THE ANGLE IS MORE OR LESS THAN PI.
LAC V1,VERT1↔MOVSI XWC(V1)↔HRRI 1↔BLT 3
LAC V2,VERT2↔MOVSI XWC(V2)↔HRRI 4↔BLT 6
LAC V3,VERT3↔MOVSI XWC(V3)↔HRRI 7↔BLT 9
FSBR 1,4↔FSBR 2,5↔FSBR 3,6 ;V1' ← (V1-V2).
FSBR 7,4↔FSBR 8,5↔FSBR 9,6 ;V3' ← (V3-V2).
LAC 2↔FMP 9↔LAC 4,↔LAC 3↔FMP 8↔FSB 4, ;V2' ← (V1 X V3).
LAC 3↔FMP 7↔LAC 5,↔LAC 1↔FMP 9↔FSB 5,
LAC 1↔FMP 8↔LAC 6,↔LAC 2↔FMP 7↔FSB 6,
FADR 1,4↔FADR 2,5↔FADR 3,6 ;V1" ← (V1'+V2').
FADR 7,4↔FADR 8,5↔FADR 9,6 ;V3" ← (V3'+V2').
;DETERM NGEATIVE INDICATES CCW ORDER, 0 TO π.
;DETERM POSITIVE INDICATES CW ORDER, π T0 2π.
CALL({DETERM+3},0)
SKIPL 1↔SKIPA 1,PI↔SETZ 1,↔PUSH P,1
;COSINE LAW.
CALL(DISTANCE,V2,V1)↔PUSH P,1
CALL(DISTANCE,V2,V3)↔PUSH P,1
CALL(DISTANCE,V1,V3)
FMPR 1,1↔MOVNS 1
POP P,2↔LAC 2↔FMPR 2,2
POP P,3↔FMP 3↔FMPR 3,3
FSC 1↔FADR 1,2↔FADR 1,3
FDVR 1,0↔CALL(ACOS,1)
POP P,0↔FADR 1,0↔POP3J
ENDR ANGL3V;4/1/73(BGB)----------------------------------------------
SUBR(DISTAN,V1,V2) ;DISTANCE BETWEEN TWO VERTICES.
COMMENT .-----------------------------------------------------------.
LAC 1,V1↔LAC 2,V2
LAC XWC(1)↔FSBR XWC(2)↔FMPR↔DAC 3
LAC YWC(1)↔FSBR YWC(2)↔FMPR↔FADRM 3
LAC ZWC(1)↔FSBR ZWC(2)↔FMPR↔FADR 3
CALL(SQRT,0)↔POP2J
ENDR DISTAN;2/10/73(BGB)---------------------------------------------
COMMENT ⊗ ENORM & VNORM
SUBR(ENORM,BODY) ;COMPUTE EDGE NORMALS FROM FACE NORMALS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,F1,F2}
LAC E,BODY
L1: PED E,E↔CAMN E,BODY↔POP1J
PFACE F1,E↔NFACE F2,E
LAC AA(F1)↔FAD AA(F2)↔FSC -1↔MOVNM AA(E)
LAC BB(F1)↔FAD BB(F2)↔FSC -1↔MOVNM BB(E)
LAC CC(F1)↔FAD CC(F2)↔FSC -1↔MOVNM CC(E)
GO L1
ENDR ENORM;1/14/73(BGB)----------------------------------------------
SUBR(VNORM,BODY) ;COMPUTE VERTEX NORMALS FROM EDGE NORMALS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,E,E0,A,B,C}
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
PED E,V↔SKIPN E0,E↔POP1J ;VERTEX BODY CASE.
SETZB 0,A↔SETZB B,C
L2: FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
CAME E,E0↔AOJA L2↔AOS
FLOAT↔FDV A,↔FDV B,↔FDV C,
DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
GO L1
ENDR VNORM;1/14/73(BGB)----------------------------------------------
⊗
SUBR(QEV,EDGE,VERTEX) ;DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
ENDR QEV;2/10/73(BGB)________________________________________________
SUBR(QFEV,FACE,EDGE,VERTEX) ;DIRECTED DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,FACE↔MOVNS 1
POP3J
ENDR QFEV;2/10/73(BGB)_______________________________________________
SUBR(CROSSING,X,Y,EDGE1,EDGE2)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E1,EDGE1↔LAC E2,EDGE2
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@X
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@Y
POP4J
ENDR CROSSING;2/10/73(BGB)-------------------------------------------
SUBR(ZDEPTH,FACE,VERTEX) ;ZPP DEPTH.
COMMENT .------------------------------------------------------------
Return AC0 =-1 when vertex is under the face;
Return AC0 = 0 when vertex is above the face;
Return AC1 = ZPP depth = (KK-AA*Xpp-BB*Ypp)/CC .
ACCUMULATORS{F,V}
EXCH V,VERTEX↔EXCH F,FACE ;GET ARGS & SAVE ACS.
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
EXCH V,VERTEX↔EXCH F,FACE ;RESTORE ACCUMULATORS.
POP2J
ENDR ZDEPTH;2/10/73(BGB)---------------------------------------------
SUBR(ZDALT,FACE,X,Y)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F}
LAC F,FACE↔LAC 1,KK(F)
LAC AA(F)↔FMPR X↔FSBR 1,0
LAC BB(F)↔FMPR Y↔FSBR 1,0
FDVR 1,CC(F)↔POP3J
ENDR ZDALT;2/10/73(BGB)----------------------------------------------
DEFINE TJOINT(Q,V)<CAR Q,2(V)>
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
SUBR(WITHIN,FACE,VERTEX) ;WITHIN 2-D PP COORDINATES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,V,E,E0}
SAVAC(5)
LAC F,FACE↔LAC V,VERTEX↔PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
CALL(LINKED↑,F,V)↔JUMPN 1,L3 ;NO SKIP - VERTEX IS PART OF THIS FACE.
TESTZ V,JUTBIT+JOTBIT↔GO[
TJOINT V,V↔CALL(LINKED↑,F,V)
JUMPN 1,L3↔GO .+1]
AOS(P) ;SKIP VERTEX WITHIN FACE.
L3: GETAC(5)
POP2J
ENDR WITHIN;2/27/73(BGB)---------------------------------------------
SUBR(WITH2D,FACE,X,Y) ;LOCUS WITHIN 2-D PP COORDINATES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0}
SAVAC(4)
LAC F,FACE↔PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR Y↔FADR 1,0
LAC AA(E)↔FMPR X↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;LOCUS IS OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
AOS(P) ;SKIP LOCUS WITHIN FACE.
L3: GETAC(4)↔POP3J
ENDR WITH2D;BGB 28 APRIL 1974 ---------------------------------------
SUBR(PPROJ,CAMERA,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ}
LAC B,WORLD↔$TYPE 0,B↔CAIE 0,$WORLD↔POP2J
;CLEAR FACE PZZ & NZZ BITS.
LAC B,WORLD
I0: CCW B,B↔CAME B,WORLD↔GO[LAC F,B
I1: PFACE F,F↔CAMN F,B↔GO I0↔MARKZ F,PZZ+NZZ↔GO I1]
;GET THE CAMERA'S FRAME.
LAC CAM,CAMERA
LAC 3(CAM)↔DAC FOCL# ;FOCAL PLANE DISTANCE.
FRAME CAM,CAM
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP2J
MARKZ B,VISIBLE
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: PVT V,V↔CAMN V,B↔GO L1
CALL(VPROJ,V,CAMERA)
;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
LAC 0,[JUTBIT+JOTBIT+PZZ+NZZ+FOLDED+VISIBLE+POTENT+7B20]
ANDCAM 0,(V) ;TURN 'EM ALL OFF.
MOVSI X,(PZZ) ; + HALFSPACE, BEHIND THE CAMERA.
MOVN FOCL
CAMGE ZZ,0 ;SKIP WHEN Zcc ≥ -FOCAL.
MOVSI X,(NZZ) ; - HALFSPACE, INVIEW.
IORM X,(V)
PED E,V↔DAC E,E0↔JUMPE E,[
PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.
MOVEI =30↔DAC TMPCNT# ;PATCH FOR CDT 2/9/75
L3: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L4 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
L4: IORM X,(E)
PFACE F,E↔IORM X,(F)
NFACE F,E↔IORM X,(F)
LAC E,1
SOSGE TMPCNT↔GO L2 ;PATCH FOR CDT 2/9/75
CAME E,E0↔GO L3↔GO L2
ENDR PPROJ;1/14/73(BGB)----------------------------------------------
SUBR(VPROJ,VERTEX,CAMERA) ;VERTEX PERSPECTIVE PROJECTION.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ,FRM}
;PICKUP ARGUMENTS.
LAC CAM,CAMERA
FRAME FRM,CAM
LAC V,VERTEX
;TRANSLATE VERTEX TO CAMERA LOCUS.
LAC X,XWC(V)↔FSBR X,XWC(FRM)
LAC Y,YWC(V)↔FSBR Y,YWC(FRM)
LAC Z,ZWC(V)↔FSBR Z,ZWC(FRM)
;ROTATE TO CAMERA ORIENTATION.
LAC XX,X↔FMPR XX,IX(FRM)
LAC Y↔FMPR IY(FRM)↔FADR XX,
LAC Z↔FMPR IZ(FRM)↔FADR XX,
LAC YY,X↔FMPR YY,JX(FRM)
LAC Y↔FMPR JY(FRM)↔FADR YY,
LAC Z↔FMPR JZ(FRM)↔FADR YY,
LAC ZZ,X↔FMPR ZZ,KX(FRM)
LAC Y↔FMPR KY(FRM)↔FADR ZZ,
LAC Z↔FMPR KZ(FRM)↔FADR ZZ,
;PERSPECTIVE TRANSFORMATION.
;XPP(V) ← SCALEX * XCC/ZCC. SCALEX = -FOCAL/PDX.
;YPP(V) ← SCALEY * YCC/ZCC. SCALEY = -FOCAL/PDY.
;ZPP(V) ← SCALEZ /ZCC. SCALEZ = -FOCAL/PDZ.
;ZPP(V) IS POSITIVE WHEN VERTEX IS INVIEW. ←←← NOTA BENE.
MOVM ZZ↔CAMGE[1E-7]↔LAC ZZ,[1E-7] ;AVOID ZERO DIVIDE.
FMPR XX,-3(CAM)↔FDVR XX,ZZ↔DAC XX,XPP(V)
FMPR YY,-2(CAM)↔FDVR YY,ZZ↔DAC YY,YPP(V)
LAC Z,-1(CAM)↔FDVR Z,ZZ↔DAC Z,ZPP(V)
SETZM 7(V)↔POP2J ;CCW IS FOR SORT WINDOW V-LISTS.
ENDR VPROJ;(BGB)-----------------------------------------------------
SUBR(UNPROJECT,VERTEX,CAMERA)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,C,R,X,Y,Z,XX,YY,ZZ}
;PICKUP ARGUMENTS.
LAC V,VERTEX
LAC C,CAMERA
FRAME R,C
;UNDO PERSPECTIVE.
LAC Z,-1(C)↔FDVR Z,ZPP(V) ;SCALEZ.
LAC Y,YPP(V)↔FMPR Y,Z↔FDVR Y,-2(C) ;SCALEY.
LAC X,XPP(V)↔FMPR X,Z↔FDVR X,-3(C) ;SCALEX.
;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
LAC XX,X↔FMPR XX,IX(R)
LAC Y↔FMPR JX(R)↔FADR XX,
LAC Z↔FMPR KX(R)↔FADR XX,
LAC YY,X↔FMPR YY,IY(R)
LAC Y↔FMPR JY(R)↔FADR YY,
LAC Z↔FMPR KY(R)↔FADR YY,
LAC ZZ,X↔FMPR ZZ,IZ(R)
LAC Y↔FMPR JZ(R)↔FADR ZZ,
LAC Z↔FMPR KZ(R)↔FADR ZZ,
;TRANSLATE TO CAMERA LOCUS.
FADR XX,XWC(R)↔DAC XX,XWC(V)
FADR YY,YWC(R)↔DAC YY,YWC(V)
FADR ZZ,ZWC(R)↔DAC ZZ,ZWC(V)
POP2J
ENDR UNPROJECT;1/14/73(BGB)------------------------------------------
SUBR(FACOEF,BF) ;FACE COEFFICIENTS. BF>0 WC, BF<0 PP.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS {Q2,Q3,E,V1,V2,V3,ABC,F,ARG,E0}
FOR @% Qε{XYZ}{FOR @$ N←1,3{ ;DEFINE X1,Y1,Z1...
DEFINE Q%$N<Q%WC(V$N)>↔}}
;FOR ALL THE FACES OF EACH BODY.
MOVM F,BF↔LAC ARG,(F) ;ORIGINAL ARG TYPE.
TLNN ARG,(BBIT)↔GO L2
L1: PFACE F,F↔TEST F,FBIT↔POP1J
;FIRST THREE VERTICES CCW ABOUT THE FACE.
L2: PED E,F↔DAC E,E0
L3: SETQ(V1,{VCW,E,F})
SETQ(V2,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
SETQ(V3,{VCCW,E,F})
;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
SKIPG BF↔GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1↔LAC 2,X2↔FMPR 2,Z3
LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2↔LAC 3,Y2↔FMPR 3,X3
LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3↔DAC 1,KK(F)
MOVMS 1↔CAML 1,[1.0]↔GO L4 ;SKIP KK TOO SMALL.
CAME E,E0↔GO L3
;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
L4: LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1↔DAC AA(F)↔FMPR↔DAC ABC
;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1↔DAC BB(F)↔FMPR↔FADRM ABC
;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1↔DAC CC(F)↔FMPR↔FADRM ABC
;NORMALIZE.
CALL(SQRT↑,ABC)↔MOVSI(<1.0>)↔FDVR 0,1
FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
TLNN ARG,(BBIT)↔POP1J↔GO L1
ENDR FACOEF;1/14/73(BGB)---------------------------------------------
SUBR(WITH3D,FACE,X,Y,Z) ;TEST FOR LOCUS WITHIN FACE 3D.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
LAC F,FACE
MOVM 1,AA(F)
MOVM 2,BB(F)
MOVM 3,CC(F)
MOVEI C0↔CAMG 1,2↔GO[
MOVEI C1↔CAMG 2,3↔MOVEI C2↔GO .+3]
CAMG 1,3↔MOVEI C2↔DAP CASE
;FIRST EDGE OF THE FACE.
SETOM FLG
PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
L1: LAC DX1,DX2
LAC DY1,DY2
LAC DZ1,DZ2
LAC Q1,Q2
;NEXT EDGE OF THE FACE.
SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.
CASE: GO
C0: LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1: LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2: LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3: FSB 0,1↔DAC Q2
JUMPE 0,L3 ;LOCUS IS ON A FUCKING EDGE !
;DETECT SIGN CHANGE.
AOJE FLG,L2 ;JUMP ON FIRST TIME THRU.
XOR Q1↔JUMPL POP4J. ;NO SKIP RETURN FALSE.
L2: CAME E,E0↔GO L1
AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3: LAC DX1↔FMP DX2 ;COSINE.
LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
SKIPGE↔AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(SOLANG,VERTEX) DIHEDRAL ANGLE AT A PIERCING VERTEX.
COMMENT .-----------------------------------------------------------.
EXTERN ACOS,DISTANCE,TWOPI
ACCUMULATORS{F,V}
LAC 1,VERTEX↔DAC 1,V0
PED 1,1↔DAC 1,E
SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV↑,F1,V0})
SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})
CALL(DISTANCE,V1,V0)↔PUSH P,1 ;L1
CALL(DISTANCE,V2,V0)↔PUSH P,1 ;L2
CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1 ;L3
;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
POP P,2↔POP P,3
LAC 2↔FMPR 3↔FSC 1
FMPR 2,2↔FMPR 3,3
FADR 1,2↔FADR 1,3
FDVR 1,0
CALL(ACOS,1)↔PUSH P,1
LAC V,V2↔LAC F,F1
LAC 0,XWC(V)↔FMPR 0,AA(F)
LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
POP P,1
CAML KK(F)↔POP1J↔MOVNS 1
FADR TWOPI↔POP1J ;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
END
EUCLID.FAI - EOF.